C   IMSL ROUTINE NAME   - LEQT2F                                        LE2F0010
C                                                                       LE2F0020
C-----------------------------------------------------------------------LE2F0030
C                                                                       LE2F0040
C   COMPUTER            - HP1000/SINGLE                                 LE2F0050
C                                                                       LE2F0060
C   LATEST REVISION     - JUNE 1, 1982                                  LE2F0070
C                                                                       LE2F0080
C   PURPOSE             - LINEAR EQUATION SOLUTION - FULL STORAGE       LE2F0090
C                           MODE - HIGH ACCURACY SOLUTION               LE2F0100
C                                                                       LE2F0110
C   USAGE               - CALL LEQT2F (A,M,N,IA,B,IDGT,WKAREA,IER)      LE2F0120
C                                                                       LE2F0130
C   ARGUMENTS    A      - INPUT MATRIX OF DIMENSION N BY N CONTAINING   LE2F0140
C                           THE COEFFICIENT MATRIX OF THE EQUATION      LE2F0150
C                           AX = B.                                     LE2F0160
C                M      - NUMBER OF RIGHT-HAND SIDES. (INPUT)           LE2F0170
C                N      - ORDER OF A AND NUMBER OF ROWS IN B. (INPUT)   LE2F0180
C                IA     - ROW DIMENSION OF A AND B EXACTLY AS SPECIFIED LE2F0190
C                           IN THE DIMENSION STATEMENT IN THE CALLING   LE2F0200
C                           PROGRAM. (INPUT)                            LE2F0210
C                B      - INPUT MATRIX OF DIMENSION N BY M CONTAINING   LE2F0220
C                           THE RIGHT-HAND SIDES OF THE EQUATION AX = B.LE2F0230
C                           ON OUTPUT, THE N BY M MATRIX OF SOLUTIONS   LE2F0240
C                           REPLACES B.                                 LE2F0250
C                IDGT   - INPUT OPTION.                                 LE2F0260
C                         IF IDGT IS GREATER THAN 0, THE ELEMENTS OF    LE2F0270
C                           A AND B ARE ASSUMED TO BE CORRECT TO IDGT   LE2F0280
C                           DECIMAL DIGITS AND THE ROUTINE PERFORMS     LE2F0290
C                           AN ACCURACY TEST.                           LE2F0300
C                         IF IDGT EQUALS 0, THE ACCURACY TEST IS        LE2F0310
C                           BYPASSED.                                   LE2F0320
C                         ON OUTPUT, IDGT CONTAINS THE APPROXIMATE      LE2F0330
C                           NUMBER OF DIGITS IN THE ANSWER WHICH        LE2F0340
C                           WERE UNCHANGED AFTER IMPROVEMENT.           LE2F0350
C                WKAREA - WORK AREA OF DIMENSION GREATER THAN OR EQUAL  LE2F0360
C                           TO N**2+3N.                                 LE2F0370
C                IER    - ERROR PARAMETER. (OUTPUT)                     LE2F0380
C                         WARNING ERROR                                 LE2F0390
C                           IER = 34 INDICATES THAT THE ACCURACY TEST   LE2F0400
C                             FAILED. THE COMPUTED SOLUTION MAY BE IN   LE2F0410
C                             ERROR BY MORE THAN CAN BE ACCOUNTED FOR   LE2F0420
C                             BY THE UNCERTAINTY OF THE DATA. THIS      LE2F0430
C                             WARNING CAN BE PRODUCED ONLY IF IDGT IS   LE2F0440
C                             GREATER THAN 0 ON INPUT. (SEE THE         LE2F0450
C                             CHAPTER L PRELUDE FOR FURTHER DISCUSSION.)LE2F0460
C                         TERMINAL ERROR                                LE2F0470
C                           IER = 129 INDICATES THAT THE MATRIX IS      LE2F0480
C                             ALGORITHMICALLY SINGULAR. (SEE THE        LE2F0490
C                             CHAPTER L PRELUDE).                       LE2F0500
C                           IER = 131 INDICATES THAT THE MATRIX IS TOO  LE2F0510
C                             ILL-CONDITIONED FOR ITERATIVE IMPROVEMENT LE2F0520
C                             TO BE EFFECTIVE.                          LE2F0530
C                                                                       LE2F0540
C   PRECISION/HARDWARE  - SINGLE AND DOUBLE/H32                         LE2F0550
C                       - SINGLE/H36,H48,H60                            LE2F0560
C                                                                       LE2F0570
C   REQD. IMSL ROUTINES - SINGLE/LUDATN,LUELMN,LUREFN,UERTST,UGETIO     LE2F0580
C                       - DOUBLE/LUDATN,LUELMN,LUREFN,UERTST,UGETIO,    LE2F0590
C                           VXADD,VXMUL,VXSTO                           LE2F0600
C                                                                       LE2F0610
C   NOTATION            - INFORMATION ON SPECIAL NOTATION AND           LE2F0620
C                           CONVENTIONS IS AVAILABLE IN THE MANUAL      LE2F0630
C                           INTRODUCTION OR THROUGH IMSL ROUTINE UHELP  LE2F0640
C                                                                       LE2F0650
C   COPYRIGHT           - 1982 BY IMSL, INC. ALL RIGHTS RESERVED.       LE2F0660
C                                                                       LE2F0670
C   WARRANTY            - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN LE2F0680
C                           APPLIED TO THIS CODE. NO OTHER WARRANTY,    LE2F0690
C                           EXPRESSED OR IMPLIED, IS APPLICABLE.        LE2F0700
C                                                                       LE2F0710
C-----------------------------------------------------------------------LE2F0720
C                                                                       LE2F0730
      SUBROUTINE LEQT2F (A,M,N,IA,B,IDGT,WKAREA,IER)                    LE2F0740
C                                                                       LE2F0750
      DIMENSION          A(IA,1),B(IA,1),WKAREA(1)                      LE2F0760
C                                  FIRST EXECUTABLE STATEMENT           LE2F0770
C                                  INITIALIZE IER                       LE2F0780
      IER=0                                                             LE2F0790
      JER=0                                                             LE2F0800
      J = N*N+1                                                         LE2F0810
      K = J+N                                                           LE2F0820
      MM = K+N                                                          LE2F0830
      KK = 0                                                            LE2F0840
      MM1 = MM-1                                                        LE2F0850
      JJ=1                                                              LE2F0860
      DO 5 L=1,N                                                        LE2F0870
         DO 5 I=1,N                                                     LE2F0880
            WKAREA(JJ)=A(I,L)                                           LE2F0890
            JJ=JJ+1                                                     LE2F0900
    5 CONTINUE                                                          LE2F0910
C                                  DECOMPOSE A                          LE2F0920
      CALL LUDATN (WKAREA,N,N,A,IA,IDGT,D1,D2,WKAREA(J),WKAREA(K),      LE2F0930
     *             WA,IER)                                              LE2F0940
      IF (IER.GT.128) GO TO 25                                          LE2F0950
      IF (IDGT .EQ. 0 .OR. IER .NE. 0) KK = 1                           LE2F0960
      DO 15 I = 1,M                                                     LE2F0970
C                                  PERFORMS THE ELIMINATION PART OF     LE2F0980
C                                  AX = B                               LE2F0990
         CALL LUELMN (A,IA,N,B(1,I),WKAREA(J),WKAREA(MM))               LE2F1000
C                                  REFINEMENT OF SOLUTION TO AX = B     LE2F1010
         IF (KK .NE. 0)                                                 LE2F1020
     *   CALL LUREFN (WKAREA,N,N,A,IA,B(1,I),IDGT,WKAREA(J),WKAREA(MM), LE2F1030
     *                WKAREA(K),WKAREA(K),JER)                          LE2F1040
         DO 10 II=1,N                                                   LE2F1050
            B(II,I) = WKAREA(MM1+II)                                    LE2F1060
   10    CONTINUE                                                       LE2F1070
         IF (JER.NE.0) GO TO 20                                         LE2F1080
   15 CONTINUE                                                          LE2F1090
      GO TO 25                                                          LE2F1100
   20 IER = 131                                                         LE2F1110
   25 JJ=1                                                              LE2F1120
      DO 30 J = 1,N                                                     LE2F1130
         DO 30 I = 1,N                                                  LE2F1140
            A(I,J)=WKAREA(JJ)                                           LE2F1150
            JJ=JJ+1                                                     LE2F1160
   30 CONTINUE                                                          LE2F1170
      IF (IER .EQ. 0) GO TO 9005                                        LE2F1180
 9000 CONTINUE                                                          LE2F1190
      CALL UERTST (IER,'LEQT2F')                                        LE2F1200
 9005 RETURN                                                            LE2F1210
      END                                                               LE2F1220
